home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM A / PD-ROM A.iso / Programming / Programming Languages / Pocket Forth rel.5 / Source code / applSource / aSupport.txt < prev    next >
Encoding:
Text File  |  1991-06-24  |  15.0 KB  |  578 lines  |  [TEXT/EDIT]
  1. ; aSupport.txt -- interface routines  3:37:12 PM  2/4/87
  2.  
  3. ; Fri Jan 22, 1988 12:52:12 version 0.3
  4. ; Fri Feb 12, 1988 13:35:10 3+ menus
  5. ; Wed Mar 30, 1988 13:37:36 opener routine
  6. ; Thu Apr 07, 1988 16:00:59 nested loads
  7. ; Mon Apr 18, 1988 14:06:09 restructure variables, echo
  8. ; Sun May 01, 1988 10:38:11 fix emptyFS to skip nil handles
  9. ; Mon May 27, 1991 17:41:00 use wne based event loop and zoomin&out handlers
  10. ; Fri May 30, 1991 05:09:00 handler for "high level events"
  11.  
  12. theWindow:    DC.L    0        ; pointer
  13.     WContRect:    DC.W    0,0
  14.     WSize:    DC.W    WHeight,WWidth
  15.     
  16. Activate:    DC.W    drop-Base    ; rel. addr. of enact routine
  17. Update:        DC.W    curs-Base    ; rel. addr. of draw routine
  18. Button:        DC.W    beep-Base    ; rel. addr. for Content action
  19. YourMenu:    DC.W    menus-Base    ; rel. addr. for additional menus
  20. Runner:        DC.W    null-Base    ; rel. addr. for idle action
  21. Closer:        DC.W    bye-Base    ; rel. addr. for Close action
  22. About:        DC.W    doabout-base    ; the about thingy
  23. Opener:        DC.W    null-base    ; open routine 3/30/88
  24. Echo:        DC.W    -1
  25.  
  26. AppleMenu:    DC.L    0
  27. FileMenu:    DC.L    0
  28. EditMenu:    DC.L    0
  29.  
  30. TextO:        DC.L    0        ; TextOffset
  31. TextE:        DC.L    0        ; TextEnd
  32. TextH:        DC.L    0        ; TextHandle
  33. FStack:        DCB.L    5,0        ; text block handles
  34. FOfsets:    DCB.L    5,0        ; text block offsets
  35. FEnds:        DCB.L    5,0        ; text block ends
  36. FSPtr:        DC.W    -4        ; file stack pointer
  37.         
  38. Events:        DC.W    Null-Base    ; Null Event - do nothing
  39.         DC.W    BDEvt-Base    ; Mouse button down
  40.         DC.W    Null-Base    ; Mouse button up - do nothing
  41.         DC.W    KeyEvt-Base    ; Key down
  42.         DC.W    Null-Base    ; Key up - do nothing
  43.         DC.W    KeyEvt-Base    ; Auto key
  44.         DC.W    UDEvt-Base    ; Update window
  45.         DC.W    Null-Base    ; Disk inserted event - do nothing
  46.         DC.W    ActEvt-Base    ; Activate window
  47.         DC.W    Null-Base    ; do nothing
  48.         DC.W    Null-Base    ; Network - do nothing
  49.         DC.W    Null-Base    ; I/O driver - do nothing
  50.         DC.W    Null-Base    ; Undefined1 - do nothing
  51.         DC.W    Null-Base    ; Undefined2 - do nothing
  52.         DC.W    Null-Base    ; Undefined3 - do nothing
  53.         DC.W    Null-Base    ; MultiTask: mouse moved & suspend/resume - do nothing
  54.  
  55. EventRecord:
  56.   What:        DC.W    0        ; WhatEvent#
  57.   Message:    DC.W    0        ; keycode, wptr, etc.
  58.    ASCII:    DC.W    0        ; ASCII code
  59.   When:        DC.L    0        ; Ticks since startup til this Event
  60.   Where:                ; Mouse coordinate for this Event
  61.    V:        DC.W    0
  62.    H:        DC.W    0
  63.   Modify:    DC.W    0        ; State of modifier keys (Shift etc.)
  64.  
  65. WWindow:    DC.L    0        ; WindowPtr returned by FindWindow
  66. Clicks:        DC.W    Null-Base    ; InDesk
  67.         DC.W    MenuBar-Base    ; InMenu Bar
  68.         DC.W    DARgn-Base    ; InSystem Window
  69.         DC.W    ContentRgn-Base    ; InContent region
  70.         DC.W    DragRgn-Base    ; InDrag region
  71.         DC.W    Null-Base    ; no grow region in this application
  72.         DC.W    CloseRgn-Base    ; ByeByeBox
  73.         DC.W    beep-base    ; inZoomIn  *** new 5/27/91 ***
  74.         DC.W    beep-base    ; inZoomOut *** new 5/27/91 ***
  75.  
  76. MFlag:        DC.W    0        ; true if multitasking *** 5/26/91 ***
  77. HLEHook:    DC.W    null-base    ; high level events hook *** 5/27/91 ***
  78.  
  79. Scratch:    DC.L    0        ; various uses
  80.  
  81. Menus:        DC.W    Fmenu-base
  82.         DC.W    Emenu-base
  83.     Fmenu:    DC.W    open-base    ; Open…
  84.         DC.W    null-base    ; -
  85.         DC.W    save-base    ; Save
  86.         DC.W    mon-base    ; Debug
  87.         DC.W    null-base    ; -
  88.         DC.W    beep-base    ; Print
  89.         DC.W    null-base    ; -
  90.         DC.W    bye-base    ; Quit
  91.     Emenu:    DC.W    beep-base    ; Undo
  92.         DC.W    null-base    ; -
  93.         DC.W    beep-base    ; Cut
  94.         DC.W    beep-base    ; Copy
  95.         DC.W    paste-base    ; Paste
  96.         DC.W    beep-base    ; Clear
  97.  
  98. BigRect:    DC.W    $8000,$8000,$7FFF,$7FFF        ; for dragging
  99.  
  100. KFlag:        DC.W    0        ; key flag
  101.  
  102. ; ----- Startup Code -----
  103.  
  104. MacStart:    ; load the menus, setup a window and create a data block
  105.     MOVEQ    #1,D3
  106.     @0: CLR.L    -(SP)            ; room
  107.     MOVE    D3,-(SP)        ; Push menu ID
  108.     _GetRMenu            ; Get menu from resource.
  109.     MOVE    D3,D0
  110.     SUBQ    #1,D0
  111.     ASL    #2,D0
  112.     LEA     AppleMenu,A0        ; menu handle data area
  113.     MOVE.L    (SP),0(A0,D0.W)        ; Save it.
  114.     CLR    -(SP)            ; Push a 0 for append.
  115.     _InsertMenu
  116.     ADDQ    #1,D3
  117.     CMP    #4,D3
  118.     BNE.S    @0            ; do the next menu
  119.  
  120.     MOVE.L    AppleMenu,-(SP)
  121.     MOVE.L    #'DRVR',-(SP)        ; Load all DRVR resource types.
  122.     _AddResMenu            ; Add the DA's.
  123.     _DrawMenuBar
  124.  
  125.     ; create a window
  126.     CLR.L    -(SP)            ; make room for the new window pointer
  127.     MOVE    #128,-(SP)        ; WIND ID
  128.     CLR.L    -(SP)            ; put it on the heap
  129.     MOVE.L    #-1,-(SP)        ; behind none
  130.     _GetNewWindow
  131.     LEA    theWindow,A0
  132.     MOVE.L  (SP),(A0)
  133.     MOVE.L    (SP),-(SP)
  134.     MOVE.L    WSize,-(SP)
  135.     CLR.W    -(SP)
  136.     _SizeWindow
  137.     MOVE.L    (SP),-(SP)
  138.     _ShowWindow
  139.     _SetPort
  140.     
  141.     ; create a temp scrap holder
  142.     MOVE.L    #10,D0            ; this is just a size
  143.     _NewHandle            ; create a handle
  144.     MOVE.L    A0,TextH-base(BP)    ; to hold clipboard data
  145.  
  146.     ; Check for multitasking environment
  147.     CLR    MFlag-base(BP)        ; set MFlag to 0
  148.     MOVE.W    #$A89F, D0        ; _Unimplemented
  149.     _GetTrapAddress            ; NGetTrapAddress
  150.     MOVE.L    A0,D1
  151.     MOVE.W    #$A860,D0        ; _WaitNextEvent
  152.     _GetTrapAddress            ; NGetTrapAddress
  153.     CMP.L    A0,D1
  154.     BEQ.S    @1            ; no multitasking
  155.     MOVE.W    #$100,MFlag-base(BP)    ; set multitasking flag
  156.  
  157.     @1:    RTS
  158.  
  159. ; ----- Event Loop ------
  160.  
  161. NextEvent:
  162.     CLR    KFlag-base(BP)
  163.  
  164.     MOVE    Runner-base(BP),D0
  165.     JSR    0(BP,D0.W)        ; run the idle routine
  166.  
  167.     CLR    -(SP)            ; turn all menus white
  168.     _HiLiteMenu
  169.  
  170.     MOVE.L    #-1,-(SP)        ; event mask and space for result
  171.     PEA    EventRecord-base(BP)    ; event record to be filled
  172.  
  173.     TST.W    MFlag-base(BP)        ; running multitasking?
  174.     BNE.S    @0            ; if not, do SystemTask/GetNextEvent
  175.  
  176.     _SystemTask            ; handle DA's, etc.
  177.     _GetNextEvent            ; fill the event record
  178.     BRA.S    @1
  179.  
  180.     @0:    MOVEQ    #0,D0
  181.     MOVE.L    D0,-(SP)        ; 0 sleep ticks
  182.     MOVE.L    D0,-(SP)        ; nil mouse region
  183.     _WaitNextEvent            ; get multitasking event
  184.  
  185.     @1:    TST    (SP)+            ; Is this an event?
  186.     BEQ.S    rdr            ;   no  this is a non-event
  187.  
  188.     MOVE    What-base(BP),D0    ; get event number
  189.     CMPI    #15,D0            ; is it a 'high level event'?
  190.     BLE.S    @2
  191.                     ; Yes: handle the new high level event
  192.     MOVE    hleHook-base(BP),D0    ;     inital value: beep
  193.     BRA.S    hop2    
  194.                     ; No: handle the old regular event
  195.     @2:    LEA    Events-base(BP),A0
  196.   hop1:    ADD    D0,D0            ;     times two for event handler address access    
  197.     MOVE    0(A0,D0.W),D0
  198.   hop2:    JMP    0(BP,D0.W)
  199.  
  200. ; -- Mouse Down Event --
  201.  
  202. BDEvt:    CLR    -(SP)            ; Result of find window
  203.     MOVE.L    Where-base(BP),-(SP)    ; Mouse point of click.
  204.     PEA    WWindow-base(BP)    ; Var. for pointer of clicked wind.
  205.     _FindWindow            ; Returns window region code ...
  206.     CLR.L    D0            ; ... (see p. WM-27 in IM).
  207.     MOVE    (SP)+,D0        ; Pop part number
  208.     LEA    Clicks-base(BP),A0    ; clicks is an array of rel.addrs
  209.     BRA.S    hop1
  210.  
  211.     MenuBar:
  212.     CLR.L    -(SP)            ; Make room for menu choice data.
  213.     MOVE.L    Where-base(BP),-(SP)    ; Mouse coordinates of click.
  214.     _MenuSelect            ; Get the selected Menu data.
  215.     MOVE.L    (SP)+,-(PS)        ; menu ID and item to pstack.
  216.     JMP    DoMenu-base(BP)
  217.         
  218.     DARgn:
  219.     PEA    EventRecord-base(BP)
  220.     MOVE.L    WWindow-base(BP),-(SP)
  221.     _SystemClick
  222.     RTS
  223.     
  224.     DragRgn:
  225.     MOVE.L    WWindow-base(BP),-(SP)    ; push The Window Pointer
  226.     MOVE.L    Where-base(BP),-(SP)    ; push The Mouse Coordinates
  227.     PEA    BigRect-base(BP)    ; The drag boundry limits
  228.     _DragWindow            ; Drag it
  229.    rdr:    RTS
  230.  
  231.     CloseRgn:
  232.     CLR    -(SP)
  233.     MOVE.L    WWindow-base(BP),-(SP)
  234.     MOVE.L    Where-base(BP),-(SP)
  235.     _TrackGoAway
  236.     MOVE    (SP)+,D0
  237.     BEQ.S    rdr
  238.     MOVE    Closer-base(BP),D0    ; inital value: bye-base
  239.     BRA.S    hop2
  240.  
  241.     ContentRgn:                ; select the clicked in window.
  242.     MOVE.L    WWindow-base(BP),-(SP)
  243.     _SelectWindow
  244.     MOVE    Button-base(BP),D0        ; inital value: null-base
  245.     BRA.S    hop2
  246.  
  247. ; -- Key Down Event --
  248.  
  249. KeyEvt:    _ObscureCursor
  250.     MOVE    Message+2-base(BP),D0
  251.     AND    #$FF,D0            ; D0 has the ASCII code of the key.
  252.     MOVE    Modify-base(BP),D1
  253.     BTST    #8,D1
  254.     BNE.S    CommandKey
  255.     MOVE    D0,kflag-base(BP)
  256.     RTS
  257.  
  258. ; Menu actions
  259.     CommandKey:                ; handle the menu choices.
  260.     CLR.L    -(SP)            ; Room for menu data.
  261.     MOVE    D0,-(SP)        ; Push ASCII.
  262.     _MenuKey            ; Get the menu data.
  263.     MOVE.L    (SP)+,-(PS)        ; menu ID and item to pstack.
  264.     
  265.     DoMenu:    ; Determine which menu was used.
  266.     TST    2(PS)            ; is the item number = 0?
  267.     BEQ    twodrop            ; no menu selection, drop data
  268.     
  269.     CMPI    #1,(PS)            ; Is it the Apple menu? ...
  270.     BEQ.S    DoAppleMenu        ; handle this special case
  271.  
  272.     CMPI    #3,(PS)            ; Is it the Edit menu?
  273.     BNE.S    @0            ; the last special case *
  274.     
  275.     CLR.L    -(SP)            ; Check if it's a DA window
  276.     _FrontWindow
  277.     MOVE.L    (SP)+,A0
  278.     TST    $6C(A0)            ; windowKind(FrontWindow)
  279.     BGE.S    @0            ; negative=dawindow
  280.  
  281.     TST    (PS)+            ; drop the menu id
  282.     CLR    -(SP)
  283.     MOVE    (PS)+,-(SP)        ; push item-1
  284.     SUBQ    #1,(SP)
  285.     _SysEdit            ; do the da edit stuff
  286.     TST    (SP)+
  287.     RTS
  288.  
  289.     @0:    MOVE    YourMenu-base(BP),D0    ; inital value:
  290.     LEA    0(BP,D0.W),A0        ; do a double indexed reference
  291.     MOVE    (PS)+,D0
  292.     SUBQ    #2,D0
  293.     ADD    D0,D0
  294.     MOVE    0(A0,D0.W),D0
  295.      LEA    0(BP,D0.W),A0
  296.     MOVE    (PS)+,D0
  297.     SUBQ    #1,D0
  298.     JMP    hop1-base(BP)
  299.  
  300. DoAppleMenu:
  301.     CLR    (PS)+
  302.     MOVE    (PS)+,D1
  303.     CMP    #1,D1            ; Is it the first item?
  304.     BNE.S    @0
  305.     MOVE    about-base(BP),D0
  306.     JMP    0(BP,D0.W)
  307.     @0:    PEA    WWindow            ; Its a DA
  308.     _GetPort
  309.     MOVE.L    AppleMenu-base(BP),-(SP)
  310.     MOVE    D1,-(SP)
  311.     PEA    @1
  312.     _GetItem
  313.     CLR    -(SP)
  314.     PEA    @1
  315.     _OpenDeskAcc
  316.     MOVE    (SP)+,D0
  317.     MOVE.L    WWindow-base(BP),-(SP)
  318.     _SetPort
  319.     RTS
  320.     @1:    DCB.B    16,0            ; Name of the DA
  321.  
  322. DoAbout:
  323.     CLR    -(SP)            ; Room for which item number.
  324.     MOVE    #257,-(SP)        ; Resource ID of AboutDialog
  325.     CLR.L    -(SP)
  326.     _Alert                ; About Item
  327.     CLR    (SP)+            ; Don't care which item dismissed.
  328.     RTS
  329.  
  330. Bye:    _ExitToShell
  331.  
  332. ; -- Update Event --
  333.  
  334. UDEvt:    PEA    WWindow-base(BP)
  335.     _GetPort
  336.     MOVE.L    WWindow-base(BP),-(SP)    ; push for _SetPort
  337.     MOVE.L    Message-base(BP),-(SP)    ; push wpointer for _EndUpdate
  338.     ANDI.L    #$00FFFFFF,(SP)        ; Mask out the wpointer field.
  339.     MOVE.L    (SP),-(SP)        ; push for _SetPort
  340.     MOVE.L    (SP),-(SP)        ; push for _BeginUpdate
  341.     _BeginUpdate            ; restrict to invalid region
  342.     _SetPort            ; specify this window
  343.     MOVE    Update-base(BP),D0    ; inital value: curs-base
  344.     JSR    0(BP,D0)        ; execute the draw routine
  345.     _EndUpdate            ; go back to current cliprgn
  346.     _SetPort
  347.     RTS
  348.  
  349. ; -- Activate Event --
  350.  
  351. ActEvt:
  352.     CLR    -(PS)            ; modify has on/off flag in bit 0
  353.     BTST    #0,Modify+1-base(BP)
  354.     BEQ.S    @0
  355.     SUBQ    #1,(PS)
  356.     @0:    MOVE    Activate-base(BP),D0    ; inital value: drop
  357.     JMP    0(BP,D0.W)
  358.  
  359.  
  360. ; ---- Other stuff ------
  361.     TextNormal:
  362.     _PenNormal            ; 1X1, black, patcopy
  363.     MOVE    #4,-(SP)        ; Monaco
  364.     _TextFont
  365.     MOVE    #0,-(SP)        ; plain text
  366.     _TextFace
  367.     MOVE    #9,-(SP)        ; 9 point
  368.     _TextSize
  369.     MOVE    #0,-(SP)        ; srcCopy
  370.     _TextMode
  371.     RTS
  372.  
  373. ClearTermBuf:
  374.     MOVEQ    #76,D0
  375.     LEA    TermBuf-base(BP),IS
  376.     @0:    MOVE.L    #$20202020,0(IS,D0)    ; fill line buffer with blanks
  377.     SUBQ.B    #4,D0
  378.     BGE.S    @0
  379.     RTS
  380.  
  381. EmptyFS: ; clear pending loads from the file stack
  382.     TST    fsptr-base(BP)
  383.     BMI.S    @1
  384.     LEA    fstack-base(BP),A1
  385.     MOVE    fsptr-base(BP),D0
  386.     MOVE.L    0(A1,D0),A0        ; A0 has the next load block addr
  387.     MOVE.L    A0,D1            ; dont try to dispose of nil handle*
  388.     BEQ.S    @0            ; *
  389.     CLR.L    0(A1,D0)
  390.     CMPA.L    TextH-base(BP),A0
  391.     BEQ.S    @0
  392.     _DisposHandle
  393.     @0:    SUBQ    #4,fsptr-base(BP)
  394.     BRA.S    emptyfs
  395.     @1:    RTS
  396.  
  397. Paste:    JSR    nocurs-base(BP)
  398.     CLR.L    -(SP)
  399.     MOVE.L    TextH-base(BP),-(SP)    ; handle to the scrap data
  400.     MOVE.L    #'TEXT',-(SP)
  401.     PEA    TextO-Base(BP)
  402.     _GetScrap
  403.     MOVE.L    (SP)+,TextE-base(BP)    ; put the length at TextE
  404.     MOVE.L    TextH-base(BP),A0    ; get a handle to the scrap data
  405.     MOVE.L    (A0),D0            ; derefrence the scrap handle
  406.     MOVE.L    D0,TextO-base(BP)    ; set TextO to start of scrap data
  407.     ADD.L    D0,TextE-base(BP)    ; set TextE to end of scrap data
  408.     _HLock                ; don't let data move during paste
  409.     CLR    fsptr-base(BP)
  410.     MOVE.L    TextH-base(BP),fstack-base(BP)
  411.     MOVE.L    TextO-base(BP),fofsets-base(BP)
  412.     MOVE.L    TextE-base(BP),fends-base(BP)
  413.     go:    CLR.B    fint-base(BP)        ; leave keyboard mode
  414.     JMP    CRet-base(BP)        ; get next line
  415.  
  416. Pasting:    ; GetInput comes here for input when fint-base(BP) is 0
  417.     JSR    ClearTermBuf-base(BP)
  418.     CLR.L    D1            ; clear the character count
  419.     CLR.L    D0            ; and the character
  420.     MOVE.L    TextO-base(BP),A0    ; set the input address
  421.     @0:    MOVE.B    0(A0,D1.W),D0        ; BEGIN  get a character
  422.     CMP.B    #CR,D0            ;     is it not a CR?
  423.     BEQ.S    @1
  424.     CMPI.B    #78,D1            ;     or 78 characters in buffer
  425.     BGE.S    @1            ; WHILE
  426.         MOVE.B    D0,0(IS,D1)        ;     stash it into buffer
  427.     ADDQ.B    #1,D1            ;     increment count
  428.     BRA.S    @0            ; REPEAT
  429.     @1:    ADDQ.B    #1,D1            ; increment count
  430.     MOVE.B    #CR,0(IS,D1)        ; stash CR into buffer
  431.     MOVE    D1,-(PS)        ; preserve count for TYPE
  432.     ADD.L    TextO-base(BP),D1
  433.     MOVE.L    D1,TextO-base(BP)
  434.     CMP.L    TextE-base(BP),D1    ; IS the block done (TextO>TextE)?
  435.     BMI.S    tandr            ; just type and return if not.
  436.     
  437.     MOVE    fsptr-base(BP),D0
  438.     LEA    fstack-base(BP),A0
  439.     MOVE.L    0(A0,D0.W),A0
  440.     _HUnlock            ; unlock the block
  441.     BMI    huh
  442.     CMPA.L    TextH-base(BP),A0
  443.     BEQ.S    @2            ; keep the scrap block
  444.     _DisposHandle            ; dispose of loaded blocks
  445.     BMI    huh
  446.  
  447.     @2:    SUBQ    #4,fsptr-base(BP)    ; pop fstack
  448.     BMI.S    @3            ; branch if no pending loads
  449.  
  450.     MOVE    fsptr-base(BP),D0
  451.     LEA    fofsets-base(BP),A0    ; set TextO to (fofsets+fsptr)
  452.     MOVE.L    0(A0,D0.W),TextO-base(BP)
  453.     LEA    fends-base(BP),A0
  454.     MOVE.L    0(A0,D0.W),TextE-base(BP)
  455.     BRA.S    tandr
  456.  
  457.     @3:    BSET.B    #7,fint-base(BP)    ; set keyboard mode
  458.  tandr:    TST    echo-base(BP)
  459.     BNE.S    @4
  460.     JMP    drop-base(BP)
  461.     
  462.     @4:    JSR    tib-base(BP)
  463.     JSR    swapp-base(BP)
  464.     JSR    type-base(BP)
  465.     JMP    doCR-base(BP)        ; TIB count TYPE CR ;
  466.  
  467. ; ----- Terminal Routines -----
  468. ; EmitCode and KeyCode implement a 64X16 terminal window.
  469.  
  470. EmitCode:    ; prints contents of D0 on current port at current location
  471.     CMP.B    #13,D0            ; is it a <cr>
  472.     BEQ.S    doCR
  473.     CMP.B    #8,D0            ; is it a <del>?
  474.     BEQ.S    doDEL
  475.     ANDI    #$FF,D0
  476.     MOVE    D0,-(A7)
  477.     _DrawChar
  478.     
  479.     PEA    Scratch-base(BP)
  480.     _GetPen                ; get current pen location
  481.     MOVE    Scratch+2-base(BP),D1    ; get h pos
  482.     MOVE    WContRect+6-base(BP),D0    ; right coord of WContRect
  483.     CMP    D0,D1            ; is the position beyond the edge
  484.     BLS.S    emitr            ; no
  485.     
  486.  doCR:    PEA    Scratch-base(BP)
  487.     _GetPen                ; get current pen location
  488.     MOVE    Scratch-base(BP),D1
  489.     MOVE    WContRect+4-base(BP),D0    ; bottom coord of WContRect
  490.     SUB    #11,D0
  491.     CMP    D0,D1            ; is the position below the window
  492.     BLS.S    @0            ; no
  493.  
  494.     ; yes it is below the bottom of the window, so scroll up 11 pixels
  495.     CLR.L    -(A7)            ; Make room for a region handle.
  496.     _NewRgn                ; get handle into (A7)
  497.     PEA    WContRect-base(BP)    ; rect to scroll
  498.     CLR    -(A7)            ; no horiz.
  499.     MOVE    #$FFF5,-(A7)        ; 11 pix. vert.
  500.     MOVE.L    8(A7),-(A7)        ; push the region handle
  501.     _ScrollRect
  502.     _DisposRgn
  503.  
  504.     MOVE    WContRect+4-base(BP),D1    ; bottom coord of WContRect
  505.     SUBQ    #4,D1
  506.     BRA.S    @1
  507.  
  508.     @0: ADD    #11,D1            ; Add line height to pen location
  509.     @1:    MOVE    #1,-(A7)
  510.     MOVE    D1,-(A7)
  511.     _MoveTo
  512.  emitr:    RTS
  513.  
  514.  doDEL:    ; it's a <del>
  515.     PEA    Scratch-base(BP)
  516.     _GetPen                ; get current pen location
  517.     MOVE    Scratch+2-base(BP),D1
  518.     CMP    #6,D1            ; first column?
  519.     BLT    Beep            ; beep return
  520.     SUB    #6,D1            ; back up
  521.     MOVE    D1,-(SP)
  522.     MOVE    Scratch,-(SP)
  523.     _MoveTo
  524.     RTS
  525.     
  526. KeyCode:    ; waits for a key to be pressed; returns the ASCII in D0.
  527.     BSR.S    Curs
  528.     @0:    JSR    NextEvent-base(BP)
  529.     TST    KFlag-base(BP)
  530.     BEQ.S    @0
  531.     BSR.S    NoCurs
  532.     MOVE    KFlag-base(BP),-(PS)
  533.     RTS
  534.  
  535. NoCurs:    MOVE    #10,-(SP)        ; SrcXor mode
  536.     _PenMode
  537.   Curs:    MOVE.L    #$00000006,-(SP)    ; move 6 pixels to the right
  538.     _Move
  539.     MOVE.L    #$0000FFFA,-(SP)    ; draw 6 pixels to the left
  540.     _Line
  541.     _PenNormal
  542.     RTS
  543.  
  544. Xpect:    MOVEM.L    D4/IS,-(SP)        ; "expect"'s routine
  545.     JSR    swapp-base(BP)        ; leave number of chars on stack
  546.     MOVE    (PS)+,D0        ; addr
  547.     LEA    0(BP,D0.W),IS        ; set IS to the input address
  548.     CLR    Counter
  549.     MOVE    (PS)+,D4
  550.     @0:    JSR    key-base(BP)
  551.     MOVE    (PS)+,D5
  552.     CMPI    #CR,D5            ; if key = CR
  553.     BNE.S    @1
  554.     MOVE.B    #BL,0(IS,Counter)
  555.     CLR.B    1(IS,Counter)
  556.     MOVE.B    #BL,2(IS,Counter)
  557.     BRA.S    @3
  558.     @1:    CMPI    #BS,D5            ; if key = backspace
  559.     BNE.S    @2
  560.     TST    Counter            ; do nothing if first key is BS
  561.     BEQ.S    @0
  562.     SUBQ    #1,Counter        ; decriment counter
  563.     JSR    dodel-base(BP)
  564.     JSR    space-base(BP)        ;    ... rubout char
  565.     JSR    dodel-base(BP)
  566.     BRA.S    @0
  567.     @2:    MOVE.B    D5,0(IS,Counter)    ; stash the key into input buffer
  568.     ADDQ    #1,Counter
  569.     MOVE    D5,D0
  570.     JSR    emitcode-base(BP)
  571.     CMP    D4,Counter        ; is count=number of chars to get?
  572.     BNE.S    @0
  573.     @3:    JSR    docr-base(BP)
  574.     MOVEM.L    (SP)+,D4/IS
  575.     RTS
  576.  
  577. ; --- End of unnamed MacSpecific Code ---
  578.